#----------------------------------------------------------------------------.

#  MONINtxx.R 2012-Abr-14 Viper@upch.edu.pe 2012-Abr-24 .


#. ---------------------------------------------------------------------- .
library(epicalc)
library(survey)
setwd("C:\\MONIN\\")
ZCRIT = qnorm(0.975)
sCSDESC <- function ( F, W, P, TVA, TGR, TNU ) { 
	x = all.vars(F)
	u = length(subset(W,!is.infinite(W[,x[1]])&!is.na(W[,x[1]]))[,x[1]])
	Q = subset ( P, !is.infinite(W[,x[1]])&!is.na(W[,x[1]]) )
	m = svymean ( F, Q, na.rm=TRUE, level=0.95, deff=TRUE )
	v = svyvar ( F, Q, na.rm=TRUE, level=0.95 )
	q = svyquantile ( F, Q, c(0.03, 0.05, 0.5, 0.95, 0.97),ci=TRUE )
	f = data.frame (
		NSUW=u,
		EAMX=as.numeric(m[1]),
		SAMX=as.numeric(sqrt(attr(m,"var"))),
		DAMX=as.numeric(attr(m,"deff")),
		LAMX=as.numeric(m[1]-ZCRIT*sqrt(attr(m,"var"))),
		UAMX=as.numeric(m[1]+ZCRIT*sqrt(attr(m,"var"))),
		EVAX=as.numeric(v[1]),
		LVAX=as.numeric(v[1]-ZCRIT*sqrt(attr(v,"var"))),
		UVAX=as.numeric(v[1]+ZCRIT*sqrt(attr(v,"var"))),
		EP03=as.numeric(q$quantiles[1]),
		LP03=as.numeric(q$CIs[1,1,1]),
		UP03=as.numeric(q$CIs[2,1,1]),
		EP05=as.numeric(q$quantiles[2]),
		LP05=as.numeric(q$CIs[1,2,1]),
		UP05=as.numeric(q$CIs[2,2,1]),
		EP50=as.numeric(q$quantiles[3]),
		LP50=as.numeric(q$CIs[1,3,1]),
		UP50=as.numeric(q$CIs[2,3,1]),
		EP95=as.numeric(q$quantiles[4]),
		LP95=as.numeric(q$CIs[1,4,1]),
		UP95=as.numeric(q$CIs[2,4,1]),
		EP97=as.numeric(q$quantiles[5]),
		LP97=as.numeric(q$CIs[1,5,1]),
		UP97=as.numeric(q$CIs[2,5,1]),
		LCAT="total", LVAR=TVA, LGRU=TGR, LNUT=TNU
	)
	f
}
gCSDESC <- function ( F, G, W, P, TVA, TGR, TNU ) { 
	x   = all.vars(F)
	g   = all.vars(G)
	NUW = table(subset(W,!is.infinite(W[,x[1]])&!is.na(W[,x[1]])&!is.na(W[,g[1]]))[,g[1]])
	NUW = NUW[NUW>0]
	Q   = subset ( P, !is.infinite(W[,x[1]])&!is.na(W[,x[1]])&!is.na(W[,g[1]]) )
	m   = svyby(F, G, Q, svymean, na.rm=TRUE, deff=TRUE)
	v   = svyby(F, G, Q, svyvar, na.rm=TRUE)
	q03 = svyby(F, G, Q, svyquantile, na.rm=TRUE, level=0.95, quantiles=0.03, ci=TRUE, vartype="ci")
	q05 = svyby(F, G, Q, svyquantile, na.rm=TRUE, level=0.95, quantiles=0.05, ci=TRUE, vartype="ci")
	q50 = svyby(F, G, Q, svyquantile, na.rm=TRUE, level=0.95, quantiles=0.50, ci=TRUE, vartype="ci")
	q95 = svyby(F, G, Q, svyquantile, na.rm=TRUE, level=0.95, quantiles=0.95, ci=TRUE, vartype="ci")
	q97 = svyby(F, G, Q, svyquantile, na.rm=TRUE, level=0.95, quantiles=0.97, ci=TRUE, vartype="ci")
	f = data.frame (
		NSUW=as.numeric(NUW),
		EAMX=as.numeric(m[,2]),
		SAMX=as.numeric(m[,3]),
		DAMX=as.numeric(m[,4]),
		LAMX=as.numeric(m[,2]-ZCRIT*m[,3]),
		UAMX=as.numeric(m[,2]+ZCRIT*m[,3]),
		EVAX=as.numeric(v[,2]),
		LVAX=as.numeric(v[,2]-ZCRIT*v[,3]),
		UVAX=as.numeric(v[,2]+ZCRIT*v[,3]),
		EP03=as.numeric(q03[,2]),
		LP03=as.numeric(q03[,3]),
		UP03=as.numeric(q03[,4]),
		EP05=as.numeric(q05[,2]),
		LP05=as.numeric(q05[,3]),
		UP05=as.numeric(q05[,4]),
		EP50=as.numeric(q50[,2]),
		LP50=as.numeric(q50[,3]),
		UP50=as.numeric(q50[,4]),
		EP95=as.numeric(q95[,2]),
		LP95=as.numeric(q95[,3]),
		UP95=as.numeric(q95[,4]),
		EP97=as.numeric(q97[,2]),
		LP97=as.numeric(q97[,3]),
		UP97=as.numeric(q97[,4]),
		LCAT=labels(NUW)[[1]], LVAR=TVA, LGRU=TGR, LNUT=TNU
	)
	f
}
vPanel  <- function ( xForm, W, vTitle, gTitle, nTitle ) { 
	Q = svydesign(id=~Cong1+Cong2, strata=~Estrato, weights=~wco, data=W)
	f = rbind (
		sCSDESC ( xForm, W, Q, vTitle, gTitle, nTitle ),
		gCSDESC ( xForm, ~Estrato, W, Q, vTitle, paste(gTitle,"x Estrato",sep=" "), nTitle ),
		gCSDESC ( xForm, ~INEIE2, W, Q, vTitle, paste(gTitle,"x mbito",sep=" "), nTitle ),
		gCSDESC ( xForm, ~Periodo, W, Q, vTitle, paste(gTitle,"x Periodo",sep=" "), nTitle ),
		gCSDESC ( xForm, ~Estac, W, Q, vTitle, paste(gTitle,"x Estacin",sep=" "), nTitle ),
		gCSDESC ( xForm, ~Sexo, W, Q, vTitle, paste(gTitle,"x Sexo",sep=" "), nTitle ),
		gCSDESC ( xForm, ~GEDAD, W, Q, vTitle, paste(gTitle,"x Edad",sep=" "), nTitle ),
		gCSDESC ( xForm, ~QMEF, W, Q, vTitle, paste(gTitle,"x Quintil",sep=" "), nTitle ),
		gCSDESC ( xForm, ~IPNBI, W, Q, vTitle, paste(gTitle,"x NBI",sep=" "), nTitle ),
		gCSDESC ( xForm, ~IPCONLM, subset(W,EdadM<24), subset(Q,EdadM<24), vTitle, paste("6-23m", "x Lactancia", sep=" "), nTitle )
	)
	f
}
nPanel  <- function ( pTitle, YIF, RQF, RQD, ULF, ULD ) { 
	W$YIF = W[,YIF]
	W$RAF = W[,YIF] / W[,RQF]
	W$RAD = W[,YIF] / W[,RQD]
	W$IMF = as.numeric ( ifelse ( is.na( W[,YIF] ), NA, ifelse ( W[,YIF] < W[,RQF], 0 , 1 ) ) )
	W$IMD = as.numeric ( ifelse ( is.na( W[,YIF] ), NA, ifelse ( W[,YIF] < W[,RQD], 0 , 1 ) ) )
	W$ILF = as.numeric ( ifelse ( is.na( W[,YIF] ), NA, ifelse ( W[,YIF] < W[,ULF], 0 , 1 ) ) )
	W$ILD = as.numeric ( ifelse ( is.na( W[,YIF] ), NA, ifelse ( W[,YIF] < W[,ULD], 0 , 1 ) ) )
	W$DIM = W[,YIF] / ( W$GCONSF - W$MAGUAG )
	W$LRD = log10 ( (W[,YIF] / W[,RQD]) + 0.01 )
	gTitle = "6-35m"
	f = vPanel ( ~YIF, W, "Ingesta", gTitle, pTitle )
	if ( length(W$RAF[!is.na(W$RAF)])>0 ) { f = rbind ( f, vPanel ( ~RAF, W, "Ingesta/FWU", gTitle, pTitle ) ) }
	if ( length(W$RAD[!is.na(W$RAD)])>0 ) { f = rbind ( f, vPanel ( ~RAD, W, "Ingesta/DRI", gTitle, pTitle ) ) }
	if ( length(W$IMF[!is.na(W$IMF)])>0 ) { f = rbind ( f, vPanel ( ~IMF, W, "Ingesta>=FWU", gTitle, pTitle ) ) }
	if ( length(W$IMD[!is.na(W$IMD)])>0 ) { f = rbind ( f, vPanel ( ~IMD, W, "Ingesta>=DRI", gTitle, pTitle ) ) }
	if ( length(W$ILF[!is.na(W$ILF)])>0 ) { f = rbind ( f, vPanel ( ~ILF, W, "Ingesta>=Lmite FWU", gTitle, pTitle ) ) }
	if ( length(W$ILD[!is.na(W$ILD)])>0 ) { f = rbind ( f, vPanel ( ~ILD, W, "Ingesta>=Lmite DRI", gTitle, pTitle ) ) }
	if ( length(W$DIM[!is.na(W$DIM)])>0 ) { f = rbind ( f, vPanel ( ~DIM, W, "Ingesta/MasaCons s/A", gTitle, pTitle ) ) }
	if ( length(W$LRD[!is.na(W$LRD)])>0 ) { f = rbind ( f, vPanel ( ~LRD, W, "Log10 Ingesta/DRI", gTitle, pTitle ) ) }
	f
}
gPanel  <- function ( xvar, W, vTitle, gTitle, nTitle ) { 
	XT = paste ( nTitle, vTitle, sep=":" )
	MT = paste ( "MONIN 2008-2010", gTitle, sep=" " )
	Q = svydesign(id=~Cong1+Cong2, strata=~Estrato, weights=~wco, data=W)
	svyhist ( as.formula(paste("~",xvar,sep="")), Q, breaks=20, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, ylab="densidad de probabilidad", xlab=XT, main=MT )
	svyboxplot ( as.formula(paste(xvar,"~","Estrato",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"Estrato"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","INEIE2",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"mbito"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","fPeriod",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"Periodo"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","Estac",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"Estacin"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","Sexo",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"Sexo"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","GEDAD",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"Edad"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","QMEF",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"Quintil"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","IPNBI",sep="")), Q, frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"NBI"), las=1 )
	svyboxplot ( as.formula(paste(xvar,"~","fIPCONLM",sep="")), subset(Q,EdadM<24), frame.plot=FALSE, horizontal=TRUE, cex.axis=0.75, cex.lab=0.75, cex.main=0.75, xlab=XT, main=paste(MT,"Lactancia"), las=1 )
}
sPanel  <- function ( pTitle, YIF, RQF, RQD, ULF, ULD ) { 
	W$YIF = W[,YIF]
	W$RAF = W[,YIF] / W[,RQF]
	W$RAD = W[,YIF] / W[,RQD]
	W$LRD = log10 ( (W[,YIF] / W[,RQD]) + 0.01 )
	gTitle = "6-35m"
	gPanel ( "YIF", W, "Ingesta", gTitle, pTitle )
	gPanel ( "RAF", W, "Ingesta/FWU", gTitle, pTitle )
	gPanel ( "RAD", W, "Ingesta/DRI", gTitle, pTitle )
	gPanel ( "LRD", W, "Log10 Ingesta/DRI", gTitle, pTitle )
}
#. ---------------------------------------------------------------------- .
# carga complementaria
W = as.data.frame(read.spss("W.sav"))
W$DENERG = W$ENERCF / ( W$GCONSF - W$MAGUAG )
W$IODOUG = 1000.0 * W$IYMGSAL
W$RETIUGF = W$RETIUF * 0.3
W$NADA = NA
W$Estrato = factor(W$Estrato,labels=c("LimaM","RCosta","SierraU","SierraR","Selva"))
W$Periodo = factor(W$Periodo)
W$nPeriod = as.numeric(W$Periodo)
W$fPeriod = factor(as.numeric(W$Periodo),labels=c("2008.4","2009.2","2009.3","2009.4","2010.1"))
W$fIPCONLM = factor(ifelse(W$IPCONLM<0,NA,W$IPCONLM),labels=c("no","si"))
W$GXKG = W$GCONSF / W$PesoKg
W$XGXKG = as.numeric(ifelse ( is.na(W$GXKG), NA, ifelse ( W$GXKG < 500, 0, 1 ) ))
W$CONCON = as.numeric ( ifelse ( as.numeric(W$Periodo)<1|is.na(W$XGXKG)|is.na(W$P3CO), NA, ifelse ( W$XGXKG==0 & W$P3CO>0, 1, 0 ) ) )
W$FRDENER = log10 ( ( W$ENERCF / W$REDRI ) + 0.01 )
W$FRDPROT = log10 ( ( W$PROTGF / W$RPDRI ) + 0.01 )
W$FRDGRAS = log10 ( ( W$GRASGF / W$RGDRI ) + 0.01 )
W$FRDHIER = log10 ( ( W$HIERMF / W$RFDRI ) + 0.01 )
W$FRDVITA = log10 ( ( 0.3 * W$RETIUF / W$RADRI ) + 0.01 )
W$FRDZINC = log10 ( ( W$ZINCMG / W$RZDRI ) + 0.01 )
W$FRDIODO = log10 ( ( 1000.0 * W$IYMGSAL / W$RIDRI ) + 0.01 )
W$FRDPOOL = ( W$FRDENER + W$FRDPROT + W$FRDHIER + W$FRDVITA + W$FRDZINC + W$FRDIODO ) / 6.0
W$RRDPOOL = ( 10^W$FRDPOOL ) - 0.01
W$HIPOOL = as.numeric ( ifelse ( is.na(W$RRDPOOL), NA, ifelse ( W$RRDPOOL > 2.0, 1, 0 ) ) )
W$LOPOOL = as.numeric ( ifelse ( is.na(W$RRDPOOL), NA, ifelse ( W$RRDPOOL < 0.5, 1, 0 ) ) )
W$pxs = (as.integer(W$Periodo)*10) + as.integer(W$Estrato)
W$wco = 1 / ( W$P1R * W$P2R * W$P3CO )
W = subset(W,!is.na(wco)&!is.na(GCONS)&CONCON==1)
W = subset ( W, EdadM>=6 & EdadM < 36 )
W$GEDAD = factor ( W$GEDAD )
W$MONIN5 = as.integer(W$Amb)
P<-svydesign(id=~Cong1+Cong2, strata=~Estrato, weights=~wco, data=W)
#. ---------------------------------------------------------------------- .
# tabulacin descriptiva (informe y primer artculo)
f1 = vPanel  ( ~DENERG, W, "Dens. Energ. KCal/g", "6-35m", "Dieta" )
f2 = nPanel  ( "Energa (KCal)", "ENERCF", "RDENER", "REDRI", "NADA", "NADA" )
f3 = nPanel  ( "Protena (g)", "PROTGF", "RDPROT", "RPDRI", "RSPROT", "UPDRI" )
f4 = nPanel  ( "Grasa (g)", "GRASGF", "NADA", "NADA", "NADA", "NADA" )
f5 = nPanel  ( "Hierro Total (mg)", "HIERMF", "RDHIER", "RFDRI", "RSHIER", "UFDRI" )
f6 = nPanel  ( "Vitamina A (ug)", "RETIUGF", "RDRETUG", "RADRI", "RSRETUG", "UADRI" )
f7 = nPanel  ( "Zinc (mg)", "ZINCMG", "RDZINC", "RZDRI", "RSZINC", "UZDRI" )
f8 = nPanel  ( "Yodo (ug)", "IODOUG", "RDIODO", "RIDRI", "RSIODO", "UIDRI" )
f = rbind ( f1, f2, f3, f4, f5, f6, f7, f8 )
write.csv ( f, "B.csv" )
pdf("B.pdf")
gPanel  ( "DENERG", W, "Dens. Energ. KCal/g", "6-35m", "Dieta" )
sPanel  ( "Energa (KCal)", "ENERCF", "RDENER", "REDRI", "NADA", "NADA" )
sPanel  ( "Protena (g)", "PROTGF", "RDPROT", "RPDRI", "RSPROT", "UPDRI" )
sPanel  ( "Grasa (g)", "GRASGF", "NADA", "RGDRI", "NADA", "NADA" )
sPanel  ( "Hierro Total (mg)", "HIERMF", "RDHIER", "RFDRI", "RSHIER", "UFDRI" )
sPanel  ( "Vitamina A (ug)", "RETIUGF", "RDRETUG", "RADRI", "RSRETUG", "UADRI" )
sPanel  ( "Zinc (mg)", "ZINCMG", "RDZINC", "RZDRI", "RSZINC", "UZDRI" )
sPanel  ( "Yodo (ug)", "IODOUG", "RDIODO", "RIDRI", "RSIODO", "UIDRI" )
dev.off()
#. ---------------------------------------------------------------------- .
